home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8408.arc / INKEY.BAS next >
BASIC Source File  |  1986-09-14  |  6KB  |  130 lines
  1. 10 DEFINT A-Z: SCREEN 0,0,0,0: WIDTH 80
  2. 15 FG=7: BF=0: COLOR FG,BG: CLS
  3. 20 DEF SEG:  POKE 106,0
  4. 30 YES = NOT NO:    NO = NOT YES
  5. 40 ESC = 27:  ESC$ = CHR$(ESC)
  6. 45 ENTR$ = CHR$(13)
  7. 50 BACKSPACE$ = CHR$(8)
  8. 60 LF.CURSOR=75:  RT.CURSOR=77
  9. 65 END.KEY=79: INS.KEY=82: DEL.KEY=83
  10. 66 HOME=71: CTRL.END=117
  11. 70 GOTO 700
  12. 90 '
  13. 91 ''''inkey routine''''
  14. 92 '
  15. 100 'FL is the field length, passed
  16. 105 'to this routine by the main program.
  17. 110 '
  18. 120 INS.LENGTH = 0:  CURSOR.POS = 1
  19. 125 SOUND 80, .03: MOVE.IT = NO: KY = 0
  20. 130 CURSOR.START = POS(0)
  21. 140 CHAR.ACCEPT.CODE = FIX( FL / 100 )
  22. 150 FL = FL - CHAR.ACCEPT.CODE*100
  23. 160 IN$ = SPACE$(FL)
  24. 170 IF PROMPT$<>""                                                               THEN IN$=LEFT$(PROMPT$+SPACE$(FL),FL)
  25. 175 INS.LENGTH=LEN(PROMPT$): PROMPT$=""
  26. 180 COLOR BG,FG
  27. 190 LOCATE, CURSOR.START, 1:   PRINT IN$;
  28. 200 LOCATE, CURSOR.START + CURSOR.POS - 1
  29. 210 N$ = INKEY$:   IF N$ = "" THEN 210
  30. 220 IF LEN(N$) = 1 THEN 350
  31. 230 ' Lines 240 thru 330 check for special keys.
  32. 235 'You can omit this section if you do not need
  33. 236 'this function.
  34. 240 KY = ASC( RIGHT$(N$,1) )
  35. 245 ' check for edit keys:
  36. 250 IF KY=LF.CURSOR THEN IF CURSOR.POS>1                                              THEN CURSOR.POS=CURSOR.POS-1:GOTO 200 ELSE 320
  37. 260 IF KY=DEL.KEY                                                                     THEN IN$=LEFT$(IN$, CURSOR.POS-1) + RIGHT$(IN$,FL-CURSOR.POS)+" ":                   INS.LENGTH = INS.LENGTH - 1:  GOTO 190
  38. 270 IF KY=INS.KEY THEN IF INSERT=NO THEN INSERT=YES
  39. 275 LOCATE,,,4,7: GOTO 190 ELSE INSERT-NO: LOCATE,,,7: GOTO210
  40. 280 IF KY = HOME THEN CURSOR.POS = 1: GOTO 200
  41. 290 IF KY = CTRL.END THEN IN$ = LEFT$(IN$,CURSOR.POS-1) +                           SPACE$(FL - CURSOR.POS + 1):   INS.LENGTH = CURSOR.POS - 1:  GOTO 190
  42. 300 IF KY= RT.CURSOR THEN CURSOR.POS = CURSOR.POS -                                 (CURSOR.POS < INS.LENGTH): GOTO 200
  43. 310 IF KY = END.KEY THEN CURSOR.POS = INS.LENGTH + 1:  GOTO 200
  44. 320 MOVE.IT = YES
  45. 330   GOTO 600  'not an edit key, but is a special key:  end input.
  46. 340 '
  47. 350 IF N$ = ESC$ THEN KY = ESC:  IN$=N$:  GOTO 320
  48. 360 IF CURSOR.POS = 1 THEN IF N$ = "-" OR N$ = "+" THEN IN$ = N$:                   COLOR FG,BG:LOCATE,,0: RETURN
  49. 370 IF CURSOR.POS > FL THEN 420
  50. 380 IF CHAR.ACCEPT.CODE = 0 AND N$ >= " " AND N$ <= "z" THEN 500
  51. 390 IF CHAR.ACCEPT.CODE = 1 AND N$ >= "0" AND N$ <= "9" THEN 500
  52. 400 IF CHAR.ACCEPT.CODE = 2 THEN IF N$ >= " " AND N$ <= "a" THEN 500                ELSE IF N$ >= "a" AND N$ <= "z" THEN N$ = CHR$(ASC(N$)-32):                     GOTO 500
  53. 410 'IF CHAR.ACCEPT.CODE=3 THEN IF MID$(ACCEPT$,CURSOR.POS,1) = ? THEN ..
  54. 420 IF N$ = ENTR$ THEN 600
  55. 430 IF N$ <> BACKSPACE$ OR CURSOR.POS = 1 THEN 210
  56. 440 '
  57. 450 IN$ = LEFT$(IN$, CURSOR.POS-2) +RIGHT$(IN$, FL -CURSOR.POS+1)+" "
  58. 460 INS.LENGTH = INS.LENGTH -1
  59. 470 CURSOR.POS = CURSOR.POS -1
  60. 480   GOTO 190
  61. 490 '
  62. 500 IF NOT INSERT THEN MID$(IN$, CURSOR.POS, 1) = N$:  GOTO 550               
  63. 510 IF INS.LENGTH >= FL  THEN 210
  64. 520 IN$= LEFT$(LEFT$(IN$,CURSOR.POS-1)+N$+RIGHT$(IN$,FL-CURSOR.POS+1),FL)
  65. 530 CURSOR.POS = CURSOR.POS + 1:   INS.LENGTH = INS.LENGTH + 1
  66. 540   GOTO 190
  67. 550 IF CURSOR.POS = 1 THEN IN$ = N$ + SPACE$(FL - 1):  PRINT IN$;:                  LOCATE, CURSOR.START:   INS.LENGTH = 1
  68. 560 PRINT N$;
  69. 570 CURSOR.POS = CURSOR.POS + 1
  70. 580 IF CURSOR.POS > INS.LENGTH THEN INS.LENGTH = CURSOR.POS - 1
  71. 590 IF FL > 1 THEN 190
  72. 600 COLOR FG,BG:  LOCATE, CURSOR.START, 0, 7:   PRINT IN$;
  73. 610 IN$ = LEFT$(IN$, INS.LENGTH):  INSERT = NO
  74. 620   RETURN
  75. 670 '
  76. 680 '                 main menu:
  77. 690 '
  78. 700 CLS
  79. 710 LOCATE  4,33:  PRINT "   MAIN MENU "
  80. 720 LOCATE 10,33:  PRINT "1  Enter Data"
  81. 730 LOCATE 11,33:  PRINT "2  Print Reports"
  82. 740 LOCATE 12,33:  PRINT "3  Save Data"
  83. 750 LOCATE 14,33:  PRINT "   SELECT  "
  84. 760 LOCATE 14,33:  FL = 101:  GOSUB 100
  85. 770 IF IN$ < "1" OR IN$ > "3" THEN 760
  86. 780 ON VAL(IN$) GOTO 1000, 2000, 3000
  87. 990 '
  88. 1000 'enter data:
  89. 1010 '
  90. 1020 CLS: LOCATE 4,35:  PRINT "DATA ENTRY":  I=1
  91. 1030 LOCATE 10,20:  PRINT "NAME:     "  NAM$(I)
  92. 1040 LOCATE 12,20:  PRINT "ADDRESS:  "  ADDR$(I)
  93. 1050 LOCATE 14,20:  PRINT "CITY:     "  CITY$(I)
  94. 1060 LOCATE 16,20:  PRINT "STATE:    "  STATE$(I)
  95. 1070 LOCATE 16,40:  PRINT "ZIP:   " ZIP$(I)
  96. 1079 '
  97. 1080 'name:
  98. 1090 LOCATE 10,30:  FL = 25:  PROMPT$ = NAM$(I):  GOSUB 100
  99. 1095 IF IN$ = ESC$ THEN 700
  100. 1100 IF MOVE.IT THEN IF I > 1 THEN I = I - 1:  GOTO 1030
  101. 1110 NAM$(I) = IN$
  102. 1120 'addr:
  103. 1130 LOCATE 12,30:  FL = 20:  PROMPT$ = ADDR$(I):  GOSUB 100
  104. 1140 IF MOVE.IT THEN 1090
  105. 1150 ADDR$(I) = IN$
  106. 1160 'city:
  107. 1170 LOCATE 14,30:  FL = 15:  PROMPT$ = CITY$(I):  GOSUB 100
  108. 1180 IF MOVE.IT THEN 1130
  109. 1190 CITY$(I) = IN$
  110. 1200 'state:
  111. 1210 LOCATE 16,30:  FL = 202:  PROMPT$ = STATE$(I):  GOSUB 100
  112. 1220 IF MOVE.IT THEN 1170
  113. 1230 STATES$="OK TX AL GA FL AZ SC MI"
  114. 1240 LOCATE 18,30
  115. 1250 IF INSTR(STATES$, IN$) = 0 THEN  PRINT "INVALID STATE":  GOTO 1210              ELSE PRINT SPACE$(13)
  116. 1260 STATE$(I) = IN$
  117. 1270 'zip
  118. 1280 LOCATE 16,47:  FL = 105:  PROMPT$ = ZIP$(I):  GOSUB 100
  119. 1290 IF MOVE.IT THEN 1210
  120. 1300 LOCATE 18,46
  121. 1310 IF VAL(IN$)<30000 OR VAL(IN$)>89999! THEN PRINT"INVALID ZIP":                   GOTO 1280: ELSE PRINT SPACE$(11)
  122. 1320 ZIP$(I) = IN$
  123. 1330 'loop:
  124. 1340 I = I + 1
  125. 1350 GOTO 1030
  126. 2000 '
  127. 2010 GOTO 700
  128. 3000 '
  129. 3010 GOTO 700
  130.